home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 24 / CU Amiga Magazine's Super CD-ROM 24 (1998)(EMAP Images)(GB)(Track 1 of 2)[!][issue 1998-07].iso / CUCD / Programming / SWI / source / src / pl-os.c < prev    next >
Encoding:
C/C++ Source or Header  |  1998-05-18  |  56.9 KB  |  2,709 lines
  1. /*  pl-os.c,v 1.45 1994/04/11 08:37:37 jan Exp
  2.  
  3.     Copyright (c) 1990 Jan Wielemaker. All rights reserved.
  4.     See ../LICENCE to find out about your rights.
  5.     jan@swi.psy.uva.nl
  6.  
  7.     Purpose: Operating System Dependencies
  8. */
  9.  
  10. /*  Modified (M) 1993 Dave Sherratt  */
  11.  
  12. /*#define O_DEBUG 1*/
  13.  
  14. #define unix 1
  15.  
  16. #if __TOS__
  17. #include <tos.h>        /* before pl-os.h due to Fopen, ... */
  18. #endif
  19. #if OS2 && EMX
  20. #include <os2.h>                /* this has to appear before pl-incl.h */
  21. #endif
  22.  
  23. #include <math.h>            /* avoid abs() problem with msvc++ */
  24. #include "pl-incl.h"
  25. #include "pl-ctype.h"
  26.  
  27. #if HAVE_SYS_STAT_H
  28. #include <sys/stat.h>
  29. #endif
  30. #if !O_XOS
  31. #define statfunc stat
  32. #endif
  33. #if HAVE_PWD_H
  34. #include <pwd.h>
  35. #endif
  36. #if HAVE_VFORK_H
  37. #include <vfork.h>
  38. #endif
  39. #ifdef HAVE_UNISTD_H
  40. #include <unistd.h>
  41. #endif
  42. #ifdef HAVE_SYS_PARAM_H
  43. #include <sys/param.h>
  44. #endif
  45. #ifdef HAVE_SYS_FILE_H
  46. #include <sys/file.h>
  47. #endif
  48.  
  49. #include <fcntl.h>
  50. #ifndef __WATCOMC__            /* appears a conflict */
  51. #include <errno.h>
  52. #endif
  53.  
  54. #if defined(__WATCOMC__)
  55. #include <io.h>
  56. #include <dos.h>
  57. #endif
  58.  
  59. #if OS2 && EMX
  60. static real initial_time;
  61. #endif /* OS2 */
  62.  
  63. forwards void    initExpand(void);
  64. forwards void    initRandom(void);
  65. forwards void    initEnviron(void);
  66. forwards long    Time(void);
  67. static void    RemoveTemporaryFiles(void);
  68.  
  69. #ifndef DEFAULT_PATH
  70. #define DEFAULT_PATH "/bin:/usr/bin"
  71. #endif
  72.  
  73.          /*******************************
  74.          *           GLOBALS        *
  75.          *******************************/
  76. #ifdef HAVE_CLOCK
  77. long clock_wait_ticks;
  78. #endif
  79.  
  80. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  81. This module is a contraction of functions that used to be all  over  the
  82. place.   together  with  pl-os.h  (included  by  pl-incl.h) this file
  83. should define a basic  layer  around  the  OS,  on  which  the  rest  of
  84. SWI-Prolog  is  based.   SWI-Prolog  has  been developed on SUN, running
  85. SunOs 3.4 and later 4.0.
  86.  
  87. Unfortunately some OS's simply do not offer  an  equivalent  to  SUN  os
  88. features.   In  most  cases part of the functionality of the system will
  89. have to be dropped. See the header of pl-incl.h for details.
  90. - - - - - - - - - - -  - - - - - */
  91.  
  92.         /********************************
  93.         *         INITIALISATION        *
  94.         *********************************/
  95.  
  96. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  97.     bool initOs()
  98.  
  99.     Initialise the OS dependant functions.
  100. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  101.  
  102. bool
  103. initOs(void)
  104. { DEBUG(1, Sdprintf("OS:initExpand() ...\n"));
  105.   initExpand();
  106.   DEBUG(1, Sdprintf("OS:initRandom() ...\n"));
  107.   initRandom();
  108.   DEBUG(1, Sdprintf("OS:initEnviron() ...\n"));
  109.   initEnviron();
  110.  
  111. #ifdef __WIN32__
  112.   if ( iswin32s() )
  113.     set(&features, DOS_FILE_NAMES_FEATURE);
  114.   else
  115.     set(&features, FILE_CASE_PRESERVING_FEATURE);
  116. #else
  117.   set(&features, FILE_CASE_FEATURE);
  118.   set(&features, FILE_CASE_PRESERVING_FEATURE);
  119. #endif
  120.  
  121. #ifdef HAVE_CLOCK
  122.   clock_wait_ticks = 0L;
  123. #endif
  124.  
  125. #if OS2
  126.   { DATETIME i;
  127.     DosGetDateTime((PDATETIME)&i);
  128.     initial_time = (i.hours * 3600.0) 
  129.                    + (i.minutes * 60.0) 
  130.            + i.seconds
  131.            + (i.hundredths / 100.0);
  132.   }
  133. #endif /* OS2 */
  134.  
  135.   DEBUG(1, Sdprintf("OS:done\n"));
  136.  
  137.   succeed;
  138. }
  139.  
  140. typedef void (*halt_function)(int, Void);
  141.  
  142. struct on_halt
  143. { halt_function    function;
  144.   Void        argument;
  145.   OnHalt    next;
  146. };
  147.  
  148.  
  149. void
  150. PL_on_halt(halt_function f, Void arg)
  151. { if ( !GD->os.halting )
  152.   { OnHalt h = allocHeap(sizeof(struct on_halt));
  153.  
  154.     h->function = f;
  155.     h->argument = arg;
  156.     startCritical;
  157.     h->next = GD->os.on_halt_list;
  158.     GD->os.on_halt_list = h;
  159.     endCritical;
  160.   }
  161. }
  162.  
  163.  
  164. volatile void
  165. Halt(int rval)
  166. { OnHalt h;
  167.   extern int Output;
  168.  
  169.   pl_notrace();                /* avoid recursive tracing */
  170.   Output = 1;                /* reset output stream to user */
  171.  
  172.   if ( !GD->os.halting )
  173.   { GD->os.halting++;            /* avoid recursion */
  174.  
  175.     for(h = GD->os.on_halt_list; h; h = h->next)
  176.       (*h->function)(rval, h->argument);
  177.  
  178.     if ( GD->initialised )
  179.     { fid_t cid = PL_open_foreign_frame();
  180.       predicate_t proc = PL_predicate("$run_at_halt", 0, "system");
  181.       PL_call_predicate(MODULE_system, FALSE, proc, 0);
  182.       PL_discard_foreign_frame(cid);
  183.     }
  184.  
  185. #if defined(__WINDOWS__) || defined(__WIN32__)
  186.     if ( rval != 0 )
  187.       PlMessage("Exit status is %d", rval);
  188. #endif
  189.  
  190.     qlfCleanup();            /* remove errornous .qlf files */
  191.     dieIO();
  192.  
  193.     if ( GD->initialised )
  194.     { fid_t cid = PL_open_foreign_frame();
  195.       predicate_t proc = PL_predicate("unload_all_foreign_libraries", 0,
  196.                       "shlib");
  197.       if ( isDefinedProcedure(proc) )
  198.     PL_call_predicate(MODULE_system, FALSE, proc, 0);
  199.       PL_discard_foreign_frame(cid);
  200.     }
  201.  
  202.     RemoveTemporaryFiles();
  203.   }
  204.  
  205.   exit(rval);
  206.   /*NOTREACHED*/
  207. }
  208.  
  209.         /********************************
  210.         *            OS ERRORS          *
  211.         *********************************/
  212.  
  213. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  214.     char *OsError()
  215.     Return a char *, holding a description of the last OS call error.
  216. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  217.  
  218. char *
  219. OsError(void)
  220. {
  221. #ifdef HAVE_STRERROR
  222. #ifdef __WIN32__
  223.   return strerror(_xos_errno());
  224. #else
  225.   return strerror(errno);
  226. #endif
  227. #else /*HAVE_STRERROR*/
  228. static char errmsg[64];
  229.  
  230. #if unix
  231.   extern int sys_nerr;
  232. #if !EMX
  233.   extern char *sys_errlist[];
  234. #endif
  235.   extern int errno;
  236.  
  237.   if ( errno < sys_nerr )
  238.     return sys_errlist[errno];
  239. #endif
  240.  
  241.   Ssprintf(errmsg, "Unknown Error (%d)", errno);
  242.   return errmsg;
  243. #endif /*HAVE_STRERROR*/
  244. }
  245.  
  246.         /********************************
  247.         *    PROCESS CHARACTERISTICS    *
  248.         *********************************/
  249.  
  250. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  251.     real CpuTime()
  252.  
  253.     Returns a floating point number, representing the amount  of  (user)
  254.     CPU-seconds  used  by the process Prolog is in.  For systems that do
  255.     not allow you to obtain this information  you  may  wish  to  return
  256.     elapsed  time  since Prolog was started, as this function is used to
  257.     by consult/1 and time/1 to determine the amount of CPU time used  to
  258.     consult a file or to execute a query.
  259. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  260.  
  261. #ifndef __WIN32__            /* defined in pl-nt.c */
  262.  
  263. #ifdef HAVE_TIMES
  264. #include <sys/times.h>
  265.  
  266. #if defined(_SC_CLK_TCK)
  267. #define Hz ((int)sysconf(_SC_CLK_TCK))
  268. #else
  269. #ifdef HZ
  270. #  define Hz HZ
  271. #else
  272. #  define Hz 60                /* if nothing better: guess */
  273. #endif
  274. #endif /*_SC_CLK_TCK*/
  275. #endif /*HAVE_TIMES*/
  276.  
  277.  
  278. real
  279. CpuTime(void)
  280. {
  281. #ifdef HAVE_TIMES
  282.   struct tms t;
  283.   static int MTOK_got_hz = FALSE;
  284.   static real MTOK_hz;
  285.  
  286.   if ( !MTOK_got_hz )
  287.   { MTOK_hz = (real) Hz;
  288.     MTOK_got_hz++;
  289.   }
  290.   times(&t);
  291.  
  292.   return (real) t.tms_utime / MTOK_hz;
  293. #endif
  294.  
  295. #if OS2 && EMX
  296.   DATETIME i;
  297.  
  298.   DosGetDateTime((PDATETIME)&i);
  299.   return (((i.hours * 3600) 
  300.                  + (i.minutes * 60) 
  301.          + i.seconds
  302.              + (i.hundredths / 100.0)) - initial_time);
  303. #endif
  304.  
  305. #ifdef HAVE_CLOCK
  306.   return (real) (clock() - clock_wait_ticks) / (real) CLOCKS_PER_SEC;
  307. #endif
  308. }
  309.  
  310. #endif /*__WIN32__*/
  311.  
  312. #ifdef HAVE_CLOCK
  313. void
  314. PL_clock_wait_ticks(long waited)
  315. { clock_wait_ticks += waited;
  316. }
  317. #endif
  318.  
  319.         /********************************
  320.         *       MEMORY MANAGEMENT       *
  321.         *********************************/
  322.  
  323. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  324.     long *Allocate(n)
  325.       long n;
  326.  
  327.     Allocate a memory area of `n' bytes from the operating system.   `n'
  328.     is a long as we need to allocate one uniform array of longs for both
  329.     the  local  stack  and  global  stack,  which  implies  it should be
  330.     possible to allocate at least a few hundred Kbytes.  If  you  cannot
  331.     implement  this  function  you  are in deep trouble.  You either can
  332.     decide to redesign large part of the data representation, or  forget
  333.     about  SWI-Prolog.   Memory  is never returned to the system.  As it
  334.     would only concern small areas,  all  over  SWI-Prolog's  memory  no
  335.     currently  available operating system (I'm aware of) will be able to
  336.     handle it anyway.  THE RETURN VALUE SHOULD BE ROUNDED TO BE A  VALID
  337.     POINTER FOR LONGS AND STRUCTURES AND AT LEAST A MULTIPLE OF 4.
  338. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  339.  
  340. Void
  341. Allocate(long n)
  342. { Void mem = malloc(n);
  343.  
  344.   return (Void) mem;
  345. }
  346.  
  347.  
  348.         /********************************
  349.         *     STRING MANIPULATION    *
  350.         ********************************/
  351.  
  352. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  353. The builtin strcmp() of SunOs is broken on some machines ...
  354. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  355.  
  356. #if sun
  357. int
  358. strcmp(const char *s1, const char *s2)
  359. { while(*s1 && *s1 == *s2)
  360.     s1++, s2++;
  361.  
  362.   return *(const unsigned char *)s1 -
  363.      *(const unsigned char *)s2;
  364. }
  365. #endif
  366.  
  367.  
  368.         /********************************
  369.         *           ARITHMETIC          *
  370.         *********************************/
  371.  
  372. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  373.     long Random()
  374.  
  375.     Return a random number. Used for arithmetic only.
  376. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  377.  
  378. static void
  379. initRandom(void)
  380. { long init = Time();
  381. #ifdef HAVE_SRANDOM
  382.   srandom(init);
  383. #else
  384. #ifdef HAVE_SRAND
  385.   srand(init);
  386. #endif
  387. #endif
  388. }
  389.  
  390. long
  391. Random(void)
  392. { 
  393. #ifdef HAVE_RANDOM
  394.   return random();
  395. #else
  396.   long l = rand();            /* 0<n<2^15-1 */
  397.   
  398.   l ^= rand()<<10;
  399.   l ^= rand()<<20;
  400.  
  401.   return l & (~PLMININT);
  402. #endif
  403. }
  404.  
  405.         /********************************
  406.         *             FILES             *
  407.         *********************************/
  408.  
  409.       /* (Everything you always wanted to know about files ...) */
  410.  
  411. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  412. Generation and administration of temporary files.  Currently  only  used
  413. by  the foreign language linker.  It might be useful to make a predicate
  414. available to the Prolog user based on these functions.  These  functions
  415. are  in  this  module as non-UNIX OS probably don't have getpid() or put
  416. temporaries on /tmp.
  417.  
  418.     atom_t TemporaryFile(const char *id)
  419.  
  420.     The return value of this call is an atom,  whose  string  represents
  421.     the  path  name of a unique file that can be used as temporary file.
  422.     `id' is a char * that can be used to make it easier to identify  the
  423.     file as a specific kind of SWI-Prolog intermediate file.
  424.  
  425.     void RemoveTemporaryFiles()
  426.  
  427.     Remove all temporary files.  This function should be  aware  of  the
  428.     fact  that some of the file names generated by TemporaryFile() might
  429.     not be created at all, or might already have been deleted.
  430. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  431.  
  432. struct tempfile
  433. { atom_t    name;
  434.   TempFile    next;
  435. };                    /* chain of temporary files */
  436.  
  437. #define tmpfile_head (GD->os._tmpfile_head)
  438. #define tmpfile_tail (GD->os._tmpfile_tail)
  439.  
  440. #ifndef DEFTMPDIR
  441. #ifdef __WIN32__
  442. #define DEFTMPDIR "c:/tmp"
  443. #else
  444. #define DEFTMPDIR "/tmp"
  445. #endif
  446. #endif
  447.  
  448. atom_t
  449. TemporaryFile(const char *id)
  450. { char temp[MAXPATHLEN];
  451.   TempFile tf = allocHeap(sizeof(struct tempfile));
  452.   char envbuf[MAXPATHLEN];
  453.   char *tmpdir;
  454.  
  455.   if ( !((tmpdir = getenv3("TEMP", envbuf, sizeof(envbuf))) ||
  456.      (tmpdir = getenv3("TMP",  envbuf, sizeof(envbuf)))) )
  457.     tmpdir = DEFTMPDIR;
  458.  
  459. #if unix
  460. { static int MTOK_temp_counter = 0;
  461.  
  462.   Ssprintf(temp, "%s/pl_%s_%d_%d",
  463.        tmpdir, id, (int) getpid(), MTOK_temp_counter++);
  464. }
  465. #endif
  466.  
  467. #ifdef __WIN32__
  468. { char *tmp;
  469.   static int temp_counter = 0;
  470.  
  471. #ifdef __LCC__
  472.   if ( (tmp = tmpnam(NULL)) )
  473. #else
  474.   if ( (tmp = _tempnam(tmpdir, id)) )
  475. #endif
  476.   { PrologPath(tmp, temp);
  477.   } else
  478.     Ssprintf(temp, "%s/pl_%s_%d", tmpdir, id, temp_counter++);
  479. }
  480. #endif
  481.  
  482. #if EMX
  483.   static int temp_counter = 0;
  484.   char *foo;
  485.  
  486.   if ( (foo = tempnam(".", (const char *)id)) )
  487.   { strcpy(temp, foo);
  488.     free(foo);
  489.   } else
  490.     Ssprintf(temp, "pl_%s_%d_%d", id, getpid(), temp_counter++);
  491. #endif
  492.  
  493. #if tos
  494.   tmpnam(temp);
  495. #endif
  496.  
  497.   tf->name = lookupAtom(temp);
  498.   tf->next = NULL;
  499.   
  500.   startCritical;
  501.   if ( !tmpfile_tail )
  502.   { tmpfile_head = tmpfile_tail = tf;
  503.   } else
  504.   { tmpfile_tail->next = tf;
  505.     tmpfile_tail = tf;
  506.   }
  507.   endCritical;
  508.  
  509.   return tf->name;
  510. }
  511.  
  512. static void
  513. RemoveTemporaryFiles()
  514. { TempFile tf, tf2;  
  515.  
  516.   startCritical;
  517.   for(tf = tmpfile_head; tf; tf = tf2)
  518.   { RemoveFile(stringAtom(tf->name));
  519.     tf2 = tf->next;
  520.     freeHeap(tf, sizeof(struct tempfile));
  521.   }
  522.  
  523.   tmpfile_head = tmpfile_tail = NULL;
  524.   endCritical;
  525. }
  526.  
  527. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  528. Fortunately most C-compilers  are  sold  with  a  library  that  defines
  529. Unix-style  access  to  the  file system.  The standard functions go via
  530. macros to deal with 16-bit machines, but are not  defined  as  functions
  531. here.   Some  more  specific things SWI-Prolog wants to know about files
  532. are defined here:
  533.  
  534.     int  getdtablesize()
  535.  
  536.     SWI-Prolog assumes it can refer to open i/o streams via  read()  and
  537.     write() by small integers, returned by open(). These integers should
  538.     be  in  the range [0, ..., getdtablesize()). If your system does not
  539.     do this you better redefine the Open(), Read() and Write() macros so
  540.     they  do  meet  this  requirement.   Prolog  allocates  a  table  of
  541.     structures with getdtablesize() entries.
  542.  
  543.     long LastModifiedFile(path)
  544.      char *path;
  545.  
  546.     Returns the last time `path' has been modified.  Used by the  source
  547.     file administration to implement make/0.
  548.  
  549.     bool ExistsFile(path)
  550.      char *path;
  551.  
  552.     Succeeds if `path' refers to the pathname of a regular file  (not  a
  553.     directory).
  554.  
  555.     bool AccessFile(path, mode)
  556.      char *path;
  557.      int mode;
  558.  
  559.     Succeeds if `path' is the pathname of an existing file and it can
  560.     be accessed in any of the inclusive or constructed argument `mode'.
  561.  
  562.     bool ExistsDirectory(path)
  563.      char *path;
  564.  
  565.     Succeeds if `path' refers to the pathname  of  a  directory.
  566.  
  567.     bool RemoveFile(path)
  568.      char *path;
  569.  
  570.     Removes a (regular) file from the  file  system.   Returns  TRUE  if
  571.     succesful FALSE otherwise.
  572.  
  573.     bool RenameFile(old, new)
  574.      char *old, *new;
  575.  
  576.     Rename file from name `old' to name `new'. If new already exists, it is
  577.     deleted. Returns TRUE if succesful, FALSE otherwise.
  578.  
  579.     bool OpenStream(stream)
  580.      int stream;
  581.  
  582.     Succeeds if `stream' refers to an open i/o stream.
  583.  
  584.     bool MarkExecutable(path)
  585.      char *path;
  586.  
  587.     Mark `path' as an executable program.  Used by the intermediate code
  588.     compiler and the creation of stand-alone executables.
  589. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  590.  
  591. #ifndef HAVE_GETDTABLESIZE
  592. int
  593. getdtablesize()
  594. {
  595. #ifdef OPEN_MAX
  596.   return OPEN_MAX;
  597. #else
  598. #ifdef _SC_OPEN_MAX            /* POSIX, USG */
  599.   return sysconf(_SC_OPEN_MAX);
  600. #else
  601. #ifdef HAVE_GETRLIMIT
  602. #ifdef HAVE_SYS_RESOURCE_H
  603. #include <sys/resource.h>
  604. #endif
  605. #ifdef RLIMIT_NOFILE
  606.   { struct rlimit rlp;
  607.     getrlimit(RLIMIT_NOFILE,&rlp);
  608.     return (rlp.rlim_cur);
  609.   }
  610. #endif /*RLIMIT_NOFILE*/
  611. #endif /*HAVE_GETRLIMIT*/
  612. #endif /*_SC_OPEN_MAX*/
  613. #endif /*OPEN_MAX*/
  614. }
  615. #endif /*HAVE_GETDTABLESIZE*/
  616.  
  617. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  618. Size of a VM page of memory.  Most BSD machines have this function.  If not,
  619. here are several alternatives ...
  620. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  621.  
  622. #ifndef HAVE_GETPAGESIZE
  623. #ifdef _SC_PAGESIZE
  624. int
  625. getpagesize()
  626. { return sysconf(_SC_PAGESIZE);
  627. }
  628. #else /*_SC_PAGESIZE*/
  629.  
  630. #if hpux
  631. #include <a.out.h>
  632. int
  633. getpagesize()
  634. {  
  635. #ifdef EXEC_PAGESIZE
  636.   return EXEC_PAGESIZE;
  637. #else
  638.   return 4096;                /* not that important */
  639. #endif
  640. }
  641. #endif /*hpux*/
  642. #endif /*_SC_PAGESIZE*/
  643. #endif /*HAVE_GETPAGESIZE*/
  644.  
  645. #if O_HPFS
  646.  
  647. /*  Conversion rules Prolog <-> OS/2 (using HPFS)
  648.     / <-> \
  649.     /x:/ <-> x:\  (embedded drive letter)
  650.     No length restrictions up to MAXPATHLEN, no case conversions.
  651. */
  652.  
  653. char *
  654. PrologPath(char *ospath, char *path)
  655. { char *s = ospath, *p = path;
  656.   int limit = MAXPATHLEN-1;
  657.  
  658.   if (isLetter(s[0]) && s[1] == ':')
  659.   { *p++ = '/';
  660.     *p++ = *s++;
  661.     *p++ = *s++;
  662.     limit -= 3;
  663.   }
  664.   for(; *s && limit; s++, p++, limit--)
  665.     *p = (*s == '\\' ? '/' : makeLower(*s));
  666.   *p = EOS;
  667.  
  668.   return path;
  669. }
  670.  
  671.  
  672. char *
  673. OsPath(const char *plpath, char *path)
  674. { const char *s = plpath, *p = path;
  675.   int limit = MAXPATHLEN-1;
  676.  
  677.   if ( s[0] == '/' && isLetter(s[1]) && s[2] == ':') /* embedded drive letter*/
  678.   { s++;
  679.     *p++ = *s++;
  680.     *p++ = *s++;
  681.     if ( *s != '/' )
  682.       *p++ = '\\';
  683.     limit -= 2;
  684.   }
  685.  
  686.   for(; *s && limit; s++, p++, limit--)
  687.     *p = (*s == '/' ? '\\' : *s);
  688.   if ( p[-1] == '\\' && p > path )
  689.     p--;
  690.   *p = EOS;
  691.  
  692.   return path;
  693. } 
  694. #endif /* O_HPFS */
  695.  
  696. #if unix
  697. char *
  698. PrologPath(const char *p, char *buf)
  699. { strcpy(buf, p);
  700.  
  701.   return buf;
  702. }
  703.  
  704. char *
  705. OsPath(const char *p, char *buf)
  706. { strcpy(buf, p);
  707.  
  708.   return buf;
  709. }
  710. #endif /*unix*/
  711.  
  712. #if O_XOS
  713. char *
  714. PrologPath(const char *p, char *buf)
  715. { _xos_canonical_filename(p, buf);
  716.   if ( !trueFeature(FILE_CASE_FEATURE) )
  717.     strlwr(buf);
  718.  
  719.   return buf;
  720. }
  721.  
  722. char *
  723. OsPath(const char *p, char *buf)
  724. { strcpy(buf, p);
  725.  
  726.   return buf;
  727. }
  728. #endif /* O_XOS */
  729.  
  730. long
  731. LastModifiedFile(char *f)
  732. { char tmp[MAXPATHLEN];
  733.  
  734. #if defined(HAVE_STAT) || defined(__unix__)
  735.   struct stat buf;
  736.  
  737.   if ( statfunc(OsPath(f, tmp), &buf) < 0 )
  738.     return -1;
  739.  
  740.   return (long)buf.st_mtime;
  741. #endif
  742.  
  743. #if tos
  744. #define DAY    (24*60*60L)
  745.   static int msize[] = {31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31};
  746.   long t;
  747.   int n;
  748.   struct ffblk buf;
  749.   struct dz
  750.   { unsigned int hour : 5;    /* hour (0-23) */
  751.     unsigned int min  : 6;    /* minute (0-59) */
  752.     unsigned int sec  : 5;    /* seconds in steps of 2 */
  753.     unsigned int year : 7;    /* year (0=1980) */
  754.     unsigned int mon  : 4;    /* month (1-12) */
  755.     unsigned int day  : 5;    /* day (1-31) */
  756.   } *dz;
  757.  
  758.   if ( findfirst(OsPath(f, tmp), &buf, FA_HIDDEN) != 0 )
  759.     return -1;
  760.   dz = (struct dz *) &buf.ff_ftime;
  761.   DEBUG(2, Sdprintf("%d/%d/%d %d:%d:%d\n",
  762.        dz->day, dz->mon, dz->year+1980, dz->hour, dz->min, dz->sec));
  763.  
  764.   t = (10*365+2) * DAY;        /* Start of 1980 */
  765.   for(n=0; n < dz->year; n++)
  766.     t += ((n % 4) == 0 ? 366 : 365) * DAY;
  767.   for(n=1; n < dz->mon; n++)
  768.     t += msize[n+1] * DAY;
  769.   t += (dz->sec * 2) + (dz->min * 60) + (dz->hour *60*60L);
  770.  
  771.   return t;
  772. #endif
  773. }  
  774.  
  775.  
  776. #ifndef F_OK
  777. #define F_OK 0
  778. #endif
  779.  
  780. bool
  781. ExistsFile(const char *path)
  782. { char tmp[MAXPATHLEN];
  783.  
  784. #ifdef HAVE_ACCESS
  785.   if ( access(OsPath(path, tmp), F_OK) == 0 )
  786.     succeed;
  787.   fail;
  788. #else
  789. #if defined(HAVE_STAT) || defined(__unix__)
  790.   struct stat buf;
  791.  
  792.   if ( statfunc(OsPath(path, tmp), &buf) == -1 ||
  793.        (buf.st_mode & S_IFMT) != S_IFREG )
  794.     fail;
  795.   succeed;
  796. #endif
  797.  
  798. #if tos
  799.   struct ffblk buf;
  800.  
  801.   if ( findfirst(OsPath(path, tmp), &buf, FA_HIDDEN) == 0 )
  802.   { DEBUG(2, Sdprintf("%s (%s) exists\n", path, OsPath(path)));
  803.     succeed;
  804.   }
  805.   DEBUG(2, Sdprintf("%s (%s) does not exist\n", path, OsPath(path)));
  806.   fail;
  807. #endif
  808. #endif
  809. }
  810.  
  811. bool
  812. AccessFile(const char *path, int mode)
  813. { char tmp[MAXPATHLEN];
  814. #ifdef HAVE_ACCESS
  815.   int m = 0;
  816.  
  817.   if ( mode == ACCESS_EXIST ) 
  818.     m = F_OK;
  819.   else
  820.   { if ( mode & ACCESS_READ    ) m |= R_OK;
  821.     if ( mode & ACCESS_WRITE   ) m |= W_OK;
  822. #ifdef X_OK
  823.     if ( mode & ACCESS_EXECUTE ) m |= X_OK;
  824. #endif
  825.   }
  826.  
  827.   return access(OsPath(path, tmp), m) == 0 ? TRUE : FALSE;
  828. #endif
  829.  
  830. #ifdef tos
  831.   struct ffblk buf;
  832.  
  833.   if ( findfirst(OsPath(path, tmp), &buf, FA_DIREC|FA_HIDDEN) != 0 )
  834.     fail;            /* does not exists */
  835.   if ( (mode & ACCESS_WRITE) && (buf.ff_attrib & FA_RDONLY) )
  836.     fail;            /* readonly file */
  837.  
  838.   succeed;
  839. #endif
  840. }
  841.  
  842. bool
  843. ExistsDirectory(const char *path)
  844. { char tmp[MAXPATHLEN];
  845.   char *ospath = OsPath(path, tmp);
  846.  
  847. #if defined(HAVE_STAT) || defined(__unix__)
  848.   struct stat buf;
  849.  
  850.   if ( statfunc(ospath, &buf) < 0 )
  851.     fail;
  852.  
  853.   if ( (buf.st_mode & S_IFMT) == S_IFDIR )
  854.     succeed;
  855.  
  856.   fail;
  857. #endif
  858.  
  859. #ifdef tos
  860.   struct ffblk buf;
  861.  
  862.   if ( findfirst(ospath, &buf, FA_DIREC|FA_HIDDEN) == 0 &&
  863.        buf.ff_attrib & FA_DIREC )
  864.     succeed;
  865.   if ( streq(ospath, ".") || streq(ospath, "..") )    /* hack */
  866.     succeed;
  867.   fail;
  868. #endif
  869. }
  870.  
  871.  
  872. long
  873. SizeFile(const char *path)
  874. { char tmp[MAXPATHLEN];
  875.   struct stat buf;
  876.  
  877. #if defined(HAVE_STAT) || defined(__unix__)
  878.   if ( statfunc(OsPath(path, tmp), &buf) == -1 )
  879.     return -1;
  880. #endif
  881.  
  882.   return buf.st_size;
  883. }
  884.  
  885.  
  886. int
  887. RemoveFile(const char *path)
  888. { char tmp[MAXPATHLEN];
  889.  
  890. #ifdef HAVE_REMOVE
  891.   return remove(OsPath(path, tmp)) == 0 ? TRUE : FALSE;
  892. #else
  893.   return unlink(OsPath(path, tmp)) == 0 ? TRUE : FALSE;
  894. #endif
  895. }
  896.  
  897.  
  898. bool
  899. RenameFile(const char *old, const char *new)
  900. { char oldbuf[MAXPATHLEN];
  901.   char newbuf[MAXPATHLEN];
  902.   char *osold, *osnew;
  903.  
  904.   osold = OsPath(old, oldbuf);
  905.   osnew = OsPath(new, newbuf);
  906.  
  907. #ifdef HAVE_RENAME
  908.   return rename(osold, osnew) == 0 ? TRUE : FALSE;
  909. #else
  910. { int rval;
  911.  
  912.   unlink(osnew);
  913.   if ( (rval = link(osold, osnew)) == 0 
  914.        && (rval = unlink(osold)) != 0)
  915.     unlink(osnew);
  916.  
  917.   if ( rval == 0 )
  918.     succeed;
  919.  
  920.   fail;
  921. }
  922. #endif /*HAVE_RENAME*/
  923. }
  924.  
  925. bool
  926. SameFile(const char *f1, const char *f2)
  927. { if ( trueFeature(FILE_CASE_FEATURE) )
  928.   { if ( streq(f1, f2) )
  929.       succeed;
  930.   } else
  931.   { if ( stricmp(f1, f2) == 0 )
  932.       succeed;
  933.   }
  934.  
  935. #ifdef unix                /* doesn't work on most not Unix's */
  936.   { struct stat buf1;
  937.     struct stat buf2;
  938.     char tmp[MAXPATHLEN];
  939.  
  940.     if ( statfunc(OsPath(f1, tmp), &buf1) != 0 ||
  941.      statfunc(OsPath(f2, tmp), &buf2) != 0 )
  942.       fail;
  943.     if ( buf1.st_ino == buf2.st_ino && buf1.st_dev == buf2.st_dev )
  944.       succeed;
  945.   }
  946. #endif
  947. #ifdef O_XOS
  948.   { char p1[MAXPATHLEN];
  949.     char p2[MAXPATHLEN];
  950.  
  951.     _xos_limited_os_filename(f1, p1);
  952.     _xos_limited_os_filename(f2, p2);
  953.     if ( trueFeature(FILE_CASE_FEATURE) )
  954.     { if ( streq(p1, p2) )
  955.     succeed;
  956.     } else
  957.     { if ( stricmp(p1, p2) == 0 )
  958.     succeed;
  959.     }
  960.   }
  961. #endif /*O_XOS*/
  962.     /* Amazing! There is no simple way to check two files for identity. */
  963.     /* stat() and fstat() both return dummy values for inode and device. */
  964.     /* this is fine as OS'es not supporting symbolic links don't need this */
  965.  
  966.   fail;
  967. }
  968.  
  969.  
  970. bool
  971. MarkExecutable(const char *name)
  972. {
  973. #if (defined(HAVE_STAT) && defined(HAVE_CHMOD)) || defined(__unix__)
  974.   struct stat buf;
  975.   int um;
  976.  
  977.   um = umask(0777);
  978.   umask(um);
  979.   if ( statfunc(name, &buf) == -1 )
  980.   { term_t file = PL_new_term_ref();
  981.  
  982.     PL_put_atom_chars(file, name);
  983.     PL_error(NULL, 0, OsError(), ERR_FILE_OPERATION,
  984.          ATOM_stat, ATOM_file, file);
  985.   }
  986.  
  987.   if ( (buf.st_mode & 0111) == (~um & 0111) )
  988.     succeed;
  989.  
  990.   buf.st_mode |= 0111 & ~um;
  991.   if ( chmod(name, buf.st_mode) == -1 )
  992.   { term_t file = PL_new_term_ref();
  993.  
  994.     PL_put_atom_chars(file, name);
  995.     PL_error(NULL, 0, OsError(), ERR_FILE_OPERATION,
  996.          ATOM_chmod, ATOM_file, file);
  997.   }
  998. #endif /* defined(HAVE_STAT) && defined(HAVE_CHMOD) */
  999.  
  1000.   succeed;
  1001. }
  1002.  
  1003. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  1004.     char *AbsoluteFile(const char *file, char *path)
  1005.  
  1006.     Expand a file specification to a system-wide unique  description  of
  1007.     the  file  that can be passed to the file functions that take a path
  1008.     as argument.  Path should refer to the same file, regardless of  the
  1009.     current  working  directory.   On  Unix absolute file names are used
  1010.     for this purpose.
  1011.  
  1012.     This  function  is  based  on  a  similar  (primitive)  function  in
  1013.     Edinburgh C-Prolog.
  1014.  
  1015.     char *BaseName(path)
  1016.      char *path;
  1017.  
  1018.     Return the basic file name for a file having path `path'.
  1019.  
  1020.     char *DirName(const char *path, char *dir)
  1021.     
  1022.     Return the directory name for a file having path `path'.
  1023. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  1024.  
  1025. #if defined(HAVE_SYMLINKS) && (defined(HAVE_STAT) || defined(__unix__))
  1026. #define O_CANONISE_DIRS
  1027.  
  1028. struct canonical_dir
  1029. { char *    name;            /* name of directory */
  1030.   char *    canonical;        /* canonical name of directory */
  1031.   dev_t        device;            /* device number */
  1032.   ino_t        inode;            /* inode number */
  1033.   CanonicalDir  next;            /* next in chain */
  1034. };
  1035.  
  1036. #define canonical_dirlist (GD->os._canonical_dirlist)
  1037.  
  1038. forwards char   *canoniseDir(char *);
  1039. #endif /*O_CANONISE_DIRS*/
  1040.  
  1041. #define CWDdir    (LD->os._CWDdir)    /* current directory */
  1042. #define CWDlen    (LD->os._CWDlen)    /* strlen(CWDdir) */
  1043.  
  1044. static void
  1045. initExpand(void)
  1046. { 
  1047. #ifdef O_CANONISE_DIRS
  1048.   char *dir;
  1049.   char *cpaths;
  1050. #endif
  1051.  
  1052.   CWDdir = NULL;
  1053.   CWDlen = 0;
  1054.  
  1055. #ifdef O_CANONISE_DIRS
  1056. { char envbuf[MAXPATHLEN];
  1057.  
  1058.   if ( (cpaths = getenv3("CANONICAL_PATHS", envbuf, sizeof(envbuf))) )
  1059.   { char buf[MAXPATHLEN];
  1060.  
  1061.     while(*cpaths)
  1062.     { char *e;
  1063.  
  1064.       if ( (e = strchr(cpaths, ':')) )
  1065.       { int l = e-cpaths;
  1066.  
  1067.     strncpy(buf, cpaths, l);
  1068.     buf[l] = EOS;
  1069.     cpaths += l+1;
  1070.     canoniseDir(buf);
  1071.       } else
  1072.       { canoniseDir(cpaths);
  1073.     break;
  1074.       }
  1075.     }
  1076.   }
  1077.  
  1078.   if ( (dir = getenv3("HOME", envbuf, sizeof(envbuf))) ) canoniseDir(dir);
  1079.   if ( (dir = getenv3("PWD",  envbuf, sizeof(envbuf))) ) canoniseDir(dir);
  1080.   if ( (dir = getenv3("CWD",  envbuf, sizeof(envbuf))) ) canoniseDir(dir);
  1081. }
  1082. #endif
  1083. }
  1084.  
  1085. #ifdef O_CANONISE_DIRS
  1086.  
  1087. static char *
  1088. canoniseDir(char *path)
  1089. { CanonicalDir d;
  1090.   struct stat buf;
  1091.   char tmp[MAXPATHLEN];
  1092.  
  1093.   DEBUG(1, Sdprintf("canoniseDir(%s) --> ", path));
  1094.  
  1095.   for(d = canonical_dirlist; d; d = d->next)
  1096.   { if ( streq(d->name, path) )
  1097.     { if ( d->name != d->canonical )
  1098.     strcpy(path, d->canonical);
  1099.  
  1100.       DEBUG(1, Sdprintf("(lookup) %s\n", path));
  1101.       return path;
  1102.     }
  1103.   }
  1104.  
  1105.   if ( statfunc(OsPath(path, tmp), &buf) == 0 )
  1106.   { CanonicalDir dn = allocHeap(sizeof(struct canonical_dir));
  1107.     char dirname[MAXPATHLEN];
  1108.     char *e = path + strlen(path);
  1109.  
  1110.     dn->next   = canonical_dirlist;
  1111.     dn->name   = store_string(path);
  1112.     dn->inode  = buf.st_ino;
  1113.     dn->device = buf.st_dev;
  1114.  
  1115.     do
  1116.     { strncpy(dirname, path, e-path);
  1117.       dirname[e-path] = EOS;
  1118.       if ( statfunc(OsPath(dirname, tmp), &buf) < 0 )
  1119.     break;
  1120.  
  1121.       DEBUG(2, Sdprintf("Checking %s (dev=%d,ino=%d)\n",
  1122.             dirname, buf.st_dev, buf.st_ino));
  1123.  
  1124.       for(d = canonical_dirlist; d; d = d->next)
  1125.       { if ( d->inode == buf.st_ino && d->device == buf.st_dev )
  1126.     { canonical_dirlist = dn;
  1127.  
  1128.       DEBUG(2, Sdprintf("Hit with %s (dev=%d,ino=%d)\n",
  1129.                 d->canonical, d->device, d->inode));
  1130.  
  1131.       strcpy(dirname, d->canonical);
  1132.       strcat(dirname, e);
  1133.       strcpy(path, dirname);
  1134.       dn->canonical = store_string(path);
  1135.       DEBUG(1, Sdprintf("(replace) %s\n", path));
  1136.       return path;
  1137.     }
  1138.       }
  1139.  
  1140.       for(e--; *e != '/' && e > path + 1; e-- )
  1141.     ;
  1142.  
  1143.     } while( e > path );
  1144.  
  1145.     dn->canonical = dn->name;
  1146.     canonical_dirlist = dn;
  1147.  
  1148.     DEBUG(1, Sdprintf("(new, existing) %s\n", path));
  1149.     return path;
  1150.   }
  1151.  
  1152.   DEBUG(1, Sdprintf("(nonexisting) %s\n", path));
  1153.   return path;
  1154. }
  1155.  
  1156. #else
  1157.  
  1158. #define canoniseDir(d)
  1159.  
  1160. #endif /*O_CANONISE_DIRS*/
  1161.  
  1162.  
  1163. static char *
  1164. canoniseFileName(char *path)
  1165. { char *out = path, *in = path;
  1166.   char *osave[100];
  1167.   int  osavep = 0;
  1168.  
  1169.   while( in[0] == '/' && in[1] == '.' && in[2] == '.' && in[3] == '/' )
  1170.     in += 3;
  1171.   if ( in[0] == '/' )
  1172.     *out++ = '/';
  1173.   osave[osavep++] = out;
  1174.  
  1175.   while(*in)
  1176.   { if (*in == '/')
  1177.     {
  1178.     again:
  1179.       if ( *in )
  1180.       { while( in[1] == '/' )
  1181.       in++;
  1182.     if ( in[1] == '.' && (in[2] == '/' || in[2] == EOS) )
  1183.     { in += 2;
  1184.       goto again;
  1185.     }
  1186.     if ( in[1] == '.' && in[2] == '.' &&
  1187.          (in[3] == '/' || in[3] == EOS) && osavep > 0 )
  1188.     { out = osave[--osavep];
  1189.       in += 3;
  1190.       goto again;
  1191.     }
  1192.       }
  1193.       if ( *in )
  1194.     in++;
  1195.       if ( out > path && out[-1] != '/' )
  1196.     *out++ = '/';
  1197.       osave[osavep++] = out;
  1198.     } else
  1199.       *out++ = *in++;
  1200.   }
  1201.   *out++ = *in++;
  1202.  
  1203.   return path;
  1204. }
  1205.  
  1206.  
  1207. char *
  1208. canonisePath(char *path)
  1209. { if ( !trueFeature(FILE_CASE_FEATURE) )
  1210.     strlwr(path);
  1211.  
  1212.   canoniseFileName(path);
  1213.  
  1214. #ifdef O_CANONISE_DIRS
  1215. { char *e;
  1216.   char dirname[MAXPATHLEN];
  1217.  
  1218.   e = path + strlen(path) - 1;
  1219.   for( ; *e != '/' && e > path; e-- )
  1220.     ;
  1221.   strncpy(dirname, path, e-path);
  1222.   dirname[e-path] = EOS;
  1223.   canoniseDir(dirname);
  1224.   strcat(dirname, e);
  1225.   strcpy(path, dirname);
  1226. }
  1227. #endif
  1228.  
  1229.   return path;
  1230. }
  1231.  
  1232.  
  1233. static char *
  1234. takeWord(const char **string, char *wrd)
  1235. { const char *s = *string;
  1236.   char *q = wrd;
  1237.   int left = MAXPATHLEN-1;
  1238.  
  1239.   while( isAlpha(*s) || *s == '_' )
  1240.   { if ( --left < 0 )
  1241.     { PL_error(NULL, 0, NULL, ERR_REPRESENTATION,
  1242.            ATOM_max_variable_length);
  1243.       return NULL;
  1244.     }
  1245.     *q++ = *s++;
  1246.   }
  1247.   *q = EOS;
  1248.   
  1249.   *string = s;
  1250.   return wrd;
  1251. }
  1252.  
  1253.  
  1254. bool
  1255. expandVars(const char *pattern, char *expanded)
  1256. { int size = 0;
  1257.   char c;
  1258.   char word[MAXPATHLEN];
  1259.  
  1260.   if ( *pattern == '~' )
  1261.   { char *user;
  1262.     char *value;
  1263.     int l;
  1264.  
  1265.     pattern++;
  1266.     user = takeWord(&pattern, word);
  1267.     if ( user[0] == EOS )        /* ~/bla */
  1268.     {
  1269. #ifdef O_XOS
  1270.       value = _xos_home();
  1271. #else /*O_XOS*/
  1272.       if ( !(value = GD->os.myhome) )
  1273.       { char envbuf[MAXPATHLEN];
  1274.  
  1275.     if ( (value = getenv3("HOME", envbuf, sizeof(envbuf))) )
  1276.     { value = GD->os.myhome = store_string(PrologPath(value, word));
  1277.     } else
  1278.     { value = GD->os.myhome = "/";
  1279.     }
  1280.       }
  1281. #endif /*O_XOS*/
  1282.     } else                /* ~fred */
  1283. #ifdef HAVE_GETPWNAM
  1284.     { struct passwd *pwent;
  1285.  
  1286.       if ( GD->os.fred && !streq(GD->os.fred, user) )
  1287.       { value = GD->os.fredshome;
  1288.       } else
  1289.       { if ( !(pwent = getpwnam(user)) )
  1290.     { if ( fileerrors )
  1291.       { term_t name = PL_new_term_ref();
  1292.  
  1293.         PL_put_atom_chars(name, user);
  1294.         PL_error(NULL, 0, NULL, ERR_EXISTENCE, ATOM_user, name);
  1295.       }
  1296.       fail;
  1297.     }
  1298.     if ( GD->os.fred )
  1299.       remove_string(GD->os.fred);
  1300.     if ( GD->os.fredshome )
  1301.       remove_string(GD->os.fredshome);
  1302.     
  1303.     GD->os.fred = store_string(user);
  1304.     value = GD->os.fredshome = store_string(pwent->pw_dir);
  1305.       }
  1306.     }      
  1307. #else
  1308.     { if ( fileerrors )
  1309.     PL_error(NULL, 0, NULL, ERR_NOTIMPLEMENTED, PL_new_atom("user_info"));
  1310.  
  1311.       fail;
  1312.     }
  1313. #endif
  1314.     size += (l = (int) strlen(value));
  1315.     if ( size >= MAXPATHLEN )
  1316.       return PL_error(NULL, 0, NULL, ERR_REPRESENTATION, ATOM_max_path_length);
  1317.     strcpy(expanded, value);
  1318.     expanded += l;
  1319.   }
  1320.  
  1321.   for( ;; )
  1322.   { switch( c = *pattern++ )
  1323.     { case EOS:
  1324.     break;
  1325.       case '$':
  1326.     { char envbuf[MAXPATHLEN];
  1327.       char *var = takeWord(&pattern, word);
  1328.       char *value = getenv3(var, envbuf, sizeof(envbuf));
  1329.       int l;
  1330.  
  1331.       if ( value == (char *) NULL )
  1332.       { if ( fileerrors )
  1333.         { term_t name = PL_new_term_ref();
  1334.  
  1335.           PL_put_atom_chars(name, var);
  1336.           PL_error(NULL, 0, NULL, ERR_EXISTENCE, ATOM_variable, name);
  1337.         }
  1338.  
  1339.         fail;
  1340.       }
  1341.       size += (l = (int)strlen(value));
  1342.       if ( size >= MAXPATHLEN )
  1343.         return PL_error(NULL, 0, NULL, ERR_REPRESENTATION,
  1344.                 ATOM_max_path_length);
  1345.       strcpy(expanded, value);
  1346.       expanded += l;
  1347.  
  1348.       continue;
  1349.     }
  1350.       default:
  1351.     if ( ++size >= MAXPATHLEN )
  1352.       return PL_error(NULL, 0, NULL, ERR_REPRESENTATION,
  1353.               ATOM_max_path_length);
  1354.     *expanded++ = c;
  1355.  
  1356.     continue;
  1357.     }
  1358.     break;
  1359.   }
  1360.  
  1361.   if ( ++size >= MAXPATHLEN )
  1362.     return PL_error(NULL, 0, NULL, ERR_REPRESENTATION,
  1363.             ATOM_max_path_length);
  1364.   *expanded = EOS;
  1365.  
  1366.   succeed;
  1367. }
  1368.  
  1369.  
  1370. static int
  1371. ExpandFile(const char *pattern, char **vector)
  1372. { char expanded[MAXPATHLEN];
  1373.   int matches = 0;
  1374.  
  1375.   if ( !expandVars(pattern, expanded) )
  1376.     return -1;
  1377.   
  1378.   vector[matches++] = store_string(expanded);
  1379.  
  1380.   return matches;
  1381. }
  1382.  
  1383.  
  1384. char *
  1385. ExpandOneFile(const char *spec, char *file)
  1386. { char *vector[256];
  1387.   int size;
  1388.  
  1389.   switch( (size=ExpandFile(spec, vector)) )
  1390.   { case -1:
  1391.       return NULL;
  1392.     case 0:
  1393.     { term_t tmp = PL_new_term_ref();
  1394.       
  1395.       PL_put_atom_chars(tmp, spec);
  1396.       PL_error(NULL, 0, "no match", ERR_EXISTENCE, ATOM_file, tmp);
  1397.  
  1398.       return NULL;
  1399.     }
  1400.     case 1:
  1401.       strcpy(file, vector[0]);
  1402.       remove_string(vector[0]);
  1403.       return file;
  1404.     default:
  1405.     { term_t tmp = PL_new_term_ref();
  1406.       int n;
  1407.       
  1408.       for(n=0; n<size; n++)
  1409.     remove_string(vector[n]);
  1410.       PL_put_atom_chars(tmp, spec);
  1411.       PL_error(NULL, 0, "ambiguous", ERR_EXISTENCE, ATOM_file, tmp);
  1412.  
  1413.       return NULL;
  1414.     }
  1415.   }
  1416. }
  1417.  
  1418.  
  1419. #ifdef O_HASDRIVES
  1420.  
  1421. int
  1422. IsAbsolutePath(const char *p)        /* /d:/ or d:/ */
  1423. { if ( p[0] == '/' && p[2] == ':' && isLetter(p[1]) &&
  1424.        (p[3] == '/' || p[3] == '\0') )
  1425.     succeed;
  1426.  
  1427.   if ( p[1] == ':' && isLetter(p[0]) && (p[2] == '/' || p[2] == '\0') )
  1428.     succeed;
  1429.  
  1430.   fail;
  1431. }
  1432.  
  1433.  
  1434. static inline int
  1435. isDriveRelativePath(const char *p)    /* '/...' */
  1436. { return p[0] == '/' && !IsAbsolutePath(p);
  1437. }
  1438.  
  1439. #ifdef __WIN32__
  1440. #undef mkdir
  1441. #include <direct.h>
  1442. #define mkdir _xos_mkdir
  1443. #endif
  1444.  
  1445. static int
  1446. GetCurrentDriveLetter()
  1447. {
  1448. #ifdef OS2
  1449.   return _getdrive();
  1450. #endif
  1451. #ifdef __WIN32__
  1452.   return _getdrive() + 'a' - 1;
  1453. #endif
  1454. #ifdef __WATCOMC__
  1455.   { unsigned drive;
  1456.     _dos_getdrive(&drive);
  1457.     return = 'a' + drive - 1;
  1458.   }
  1459. #endif
  1460. }
  1461.  
  1462. #else /*O_HASDRIVES*/
  1463.  
  1464. int
  1465. IsAbsolutePath(const char *p)
  1466. { return p[0] == '/';
  1467. }
  1468.  
  1469. #endif /*O_HASDRIVES*/
  1470.  
  1471. #define isRelativePath(p) ( p[0] == '.' )
  1472.  
  1473.  
  1474. char *
  1475. AbsoluteFile(const char *spec, char *path)
  1476. { char tmp[MAXPATHLEN];
  1477.   char buf[MAXPATHLEN];
  1478.   char *file;  
  1479.  
  1480.   PrologPath(spec, buf);
  1481.   if ( !(file = ExpandOneFile(buf, tmp)) )
  1482.     return (char *) NULL;
  1483.  
  1484.   if ( IsAbsolutePath(file) )
  1485.   { strcpy(path, file);
  1486.  
  1487.     return canonisePath(path);
  1488.   }
  1489.  
  1490. #ifdef O_HASDRIVES
  1491.   if ( isDriveRelativePath(file) )    /* /something  --> d:/something */
  1492.   { if ((strlen(file) + 3) > MAXPATHLEN)
  1493.     { PL_error(NULL, 0, NULL, ERR_REPRESENTATION, ATOM_max_path_length);
  1494.       return (char *) NULL;
  1495.     }
  1496.     path[0] = GetCurrentDriveLetter();
  1497.     path[1] = ':';
  1498.     strcpy(&path[2], file);
  1499.     return canonisePath(path);
  1500.   }
  1501. #endif /*O_HASDRIVES*/
  1502.  
  1503.   if ( CWDlen == 0 )
  1504.   { char buf[MAXPATHLEN];
  1505.     char *rval;
  1506.  
  1507. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  1508. On SunOs, getcwd() is using popen() to read the output of /bin/pwd.  This
  1509. is slow and appears not to cooperate with profile/3.  getwd() is supposed
  1510. to be implemented directly.  What about other Unixes?
  1511. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  1512.  
  1513. #if defined(HAVE_GETWD) && (defined(__sun__) || !defined(HAVE_GETCWD))
  1514.     rval = getwd(buf);
  1515. #else
  1516.     rval = getcwd(buf, MAXPATHLEN);
  1517. #endif
  1518.     if ( !rval )
  1519.     { term_t tmp = PL_new_term_ref();
  1520.  
  1521.       PL_put_atom(tmp, ATOM_dot);
  1522.       PL_error(NULL, 0, OsError(), ERR_FILE_OPERATION,
  1523.            ATOM_getcwd, ATOM_directory, tmp);
  1524.     }
  1525.  
  1526.     canonisePath(buf);
  1527.     CWDlen = strlen(buf);
  1528.     buf[CWDlen++] = '/';
  1529.     buf[CWDlen] = EOS;
  1530.     
  1531.     if ( CWDdir )
  1532.       remove_string(CWDdir);
  1533.     CWDdir = store_string(buf);
  1534.   }
  1535.  
  1536.   if ( (CWDlen + strlen(file) + 1) >= MAXPATHLEN )
  1537.   { PL_error(NULL, 0, NULL, ERR_REPRESENTATION, ATOM_max_path_length);
  1538.     return (char *) NULL;
  1539.   }
  1540.   
  1541.   strcpy(path, CWDdir);
  1542.   if ( file[0] != EOS )
  1543.     strcpy(&path[CWDlen], file);
  1544.   if ( strchr(file, '.') || strchr(file, '/') )
  1545.     return canonisePath(path);
  1546.   else
  1547.     return path;
  1548. }
  1549.  
  1550.  
  1551. char *
  1552. BaseName(register char *f)
  1553. { register char *base;
  1554.  
  1555.   for(base = f; *f; f++)
  1556.   { if (*f == '/')
  1557.       base = f+1;
  1558.   }
  1559.  
  1560.   return base;
  1561. }
  1562.  
  1563.  
  1564. char *
  1565. DirName(const char *f, char *dir)
  1566. { const char *base, *p;
  1567.  
  1568.   for(base = p = f; *p; p++)
  1569.   { if (*p == '/' && p[1] != EOS )
  1570.       base = p+1;
  1571.   }
  1572.   strncpy(dir, f, base-f);
  1573.   dir[base-f] = EOS;
  1574.   
  1575.   return dir;
  1576. }
  1577.  
  1578.  
  1579. char *
  1580. ReadLink(const char *f, char *buf)
  1581. {
  1582. #ifdef HAVE_READLINK
  1583.   int n;
  1584.  
  1585.   if ( (n=readlink(f, buf, MAXPATHLEN-1)) > 0 )
  1586.   { buf[n] = EOS;
  1587.     return buf;
  1588.   }
  1589. #endif
  1590.  
  1591.   return NULL;
  1592. }
  1593.  
  1594.  
  1595. static char *
  1596. DeRefLink1(const char *f, char *lbuf)
  1597. { char buf[MAXPATHLEN];
  1598.   char *l;
  1599.  
  1600.   if ( (l=ReadLink(f, buf)) )
  1601.   { if ( l[0] == '/' )            /* absolute path */
  1602.     { strcpy(lbuf, buf);
  1603.       return lbuf;
  1604.     } else
  1605.     { char *q;
  1606.  
  1607.       strcpy(lbuf, f);
  1608.       q = &lbuf[strlen(lbuf)];
  1609.       while(q>lbuf && q[-1] != '/')
  1610.     q--;
  1611.       strcpy(q, l);
  1612.  
  1613.       canoniseFileName(lbuf);
  1614.  
  1615.       return lbuf;
  1616.     }
  1617.   }
  1618.  
  1619.   return NULL;
  1620. }
  1621.  
  1622.  
  1623. char *
  1624. DeRefLink(const    char *link, char *buf)
  1625. { char tmp[MAXPATHLEN];
  1626.   char *f;
  1627.   int n = 20;                /* avoid loop! */
  1628.  
  1629.   while((f=DeRefLink1(link, tmp)) && n-- > 0)
  1630.     link = f;
  1631.  
  1632.   if ( n > 0 )
  1633.   { strcpy(buf, link);
  1634.     return buf;
  1635.   } else
  1636.     return NULL;
  1637. }
  1638.  
  1639.  
  1640.  
  1641. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  1642.     bool ChDir(path)
  1643.      char *path;
  1644.  
  1645.     Change the current working directory to `path'.  File names may depend
  1646.     on `path'.
  1647. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  1648.  
  1649. bool
  1650. ChDir(const char *path)
  1651. { char ospath[MAXPATHLEN];
  1652.   char tmp[MAXPATHLEN];
  1653.  
  1654.   OsPath(path, ospath);
  1655.  
  1656.   if ( path[0] == EOS || streq(path, ".") ||
  1657.        (CWDdir && streq(path, CWDdir)) )
  1658.     succeed;
  1659.  
  1660.   AbsoluteFile(path, tmp);
  1661.  
  1662.   if ( chdir(ospath) == 0 )
  1663.   { int len;
  1664.  
  1665.     len = strlen(tmp);
  1666.     if ( len == 0 || tmp[len-1] != '/' )
  1667.     { tmp[len++] = '/';
  1668.       tmp[len] = EOS;
  1669.     }
  1670.     CWDlen = len;
  1671.     if ( CWDdir )
  1672.       remove_string(CWDdir);
  1673.     CWDdir = store_string(tmp);
  1674.  
  1675.     succeed;
  1676.   }
  1677.  
  1678.   fail;
  1679. }
  1680.  
  1681.  
  1682.  
  1683.         /********************************
  1684.         *        TIME CONVERSION        *
  1685.         *********************************/
  1686.  
  1687. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  1688.     struct tm *LocalTime(time)
  1689.           long *time;
  1690.  
  1691.     Convert time in Unix internal form (seconds since Jan 1 1970) into a
  1692.     structure providing easier access to the time.
  1693.  
  1694.     For non-Unix systems: struct time is supposed  to  look  like  this.
  1695.     Move  This  definition to pl-os.h and write the conversion functions
  1696.     here.
  1697.  
  1698.     struct tm {
  1699.     int    tm_sec;        / * second in the minute (0-59)* /
  1700.     int    tm_min;        / * minute in the hour (0-59) * /
  1701.     int    tm_hour;    / * hour of the day (0-23) * /
  1702.     int    tm_mday;    / * day of the month (1-31) * /
  1703.     int    tm_mon;        / * month of the year (1-12) * /
  1704.     int    tm_year;    / * year (0 = 1900) * /
  1705.     int    tm_wday;    / * day in the week (1-7, 1 = sunday) * /
  1706.     int    tm_yday;    / * day in the year (0-365) * /
  1707.     int    tm_isdst;    / * daylight saving time info * /
  1708.     };
  1709.  
  1710.     long Time()
  1711.  
  1712.     Return time in seconds after Jan 1 1970 (Unix' time notion).
  1713. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  1714.  
  1715. struct tm *
  1716. LocalTime(long int *t)
  1717. { return localtime((const time_t *) t);
  1718. }
  1719.  
  1720.  
  1721. static long
  1722. Time(void)
  1723. { return (long)time((time_t *) NULL);
  1724. }
  1725.  
  1726.  
  1727. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  1728.             TERMINAL IO MANIPULATION
  1729.  
  1730. ResetStdin()
  1731.     Clear the Sinput buffer after a saved state.  Only necessary
  1732.     if O_SAVE is defined.
  1733.  
  1734. PushTty()
  1735.     Push the tty to the specified state.
  1736.  
  1737. PopTty()
  1738.     Restore the tty state.
  1739. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  1740.  
  1741. static void
  1742. ResetStdin()
  1743. { Sinput->limitp = Sinput->bufp = Sinput->buffer;
  1744.   if ( !GD->os.org_terminal.read )
  1745.     GD->os.org_terminal = *Sinput->functions;
  1746. }
  1747.  
  1748. static int
  1749. Swrite_protocol(void *handle, char *buf, int size)
  1750. { int rval;
  1751. #ifdef HAVE_CLOCK
  1752.   long oldclock = clock();
  1753. #endif
  1754.  
  1755.   protocol(buf, size);
  1756.  
  1757.   rval = (*GD->os.org_terminal.write)(handle, buf, size);
  1758.  
  1759. #ifdef HAVE_CLOCK
  1760.   clock_wait_ticks += clock() - oldclock;
  1761. #endif
  1762.  
  1763.   return rval;
  1764. }
  1765.  
  1766. int
  1767. Sread_terminal(void *handle, char *buf, int size)
  1768. { long h     = (long)handle;
  1769.   atom_t sfn = source_file_name;        /* save over call-back */
  1770.   int    sln = source_line_no;
  1771.   int     fd = (int)h;
  1772.  
  1773.   if ( GD->os.prompt_next && ttymode != TTY_RAW )
  1774.   { Putf("%s", PrologPrompt());
  1775.     
  1776.     GD->os.prompt_next = FALSE;
  1777.   }
  1778.  
  1779.   pl_ttyflush();
  1780.   PL_dispatch(fd, PL_DISPATCH_WAIT);
  1781.   size = (*GD->os.org_terminal.read)(handle, buf, size);
  1782.  
  1783.   if ( size == 0 )            /* end-of-file */
  1784.   { if ( fd == 0 )
  1785.     { Sclearerr(Sinput);
  1786.       GD->os.prompt_next = TRUE;
  1787.     }
  1788.   } else if ( size > 0 && buf[size-1] == '\n' )
  1789.     GD->os.prompt_next = TRUE;
  1790.  
  1791.   source_line_no   = sln;
  1792.   source_file_name = sfn;
  1793.  
  1794.   return size;
  1795. }
  1796.  
  1797. void
  1798. ResetTty()
  1799. { startCritical;
  1800.   ResetStdin();
  1801.  
  1802.   if ( !GD->os.iofunctions.read )
  1803.   { GD->os.iofunctions       = *Sinput->functions;
  1804.     GD->os.iofunctions.read  = Sread_terminal;
  1805.     GD->os.iofunctions.write = Swrite_protocol;
  1806.  
  1807.     Sinput->functions  = 
  1808.     Soutput->functions = 
  1809.     Serror->functions  = &GD->os.iofunctions;
  1810.   }
  1811.   GD->os.prompt_next = TRUE;
  1812.   endCritical;
  1813. }
  1814.  
  1815. #ifdef O_HAVE_TERMIO            /* sys/termios.h or sys/termio.h */
  1816.  
  1817. #ifndef HAVE_TCSETATTR
  1818. #ifndef NO_SYS_IOCTL_H_WITH_SYS_TERMIOS_H
  1819. #include <sys/ioctl.h>
  1820. #endif
  1821. #ifndef TIOCGETA
  1822. #define TIOCGETA TCGETA
  1823. #endif
  1824. #endif
  1825.  
  1826. bool
  1827. PushTty(ttybuf *buf, int mode)
  1828. { struct termios tio;
  1829.  
  1830.   buf->mode = ttymode;
  1831.   ttymode = mode;
  1832.  
  1833.   if ( GD->cmdline.notty )
  1834.     succeed;
  1835.  
  1836. #ifdef HAVE_TCSETATTR 
  1837.   if ( tcgetattr(0, &buf->tab) )    /* save the old one */
  1838.     fail;
  1839. #else
  1840.   if ( ioctl(0, TIOCGETA, &buf->tab) )    /* save the old one */
  1841.     fail;
  1842. #endif
  1843.  
  1844.   tio = buf->tab;
  1845.  
  1846.   switch( mode )
  1847.   { case TTY_RAW:
  1848. #if defined(HAVE_TCSETATTR) && defined(HAVE_CFMAKERAW)
  1849.     cfmakeraw(&tio);
  1850.     tio.c_oflag = buf->tab.c_oflag;    /* donot change output modes */
  1851.     tio.c_lflag |= ISIG;
  1852. #else
  1853.     tio.c_lflag &= ~(ECHO|ICANON);
  1854.     tio.c_cc[VTIME] = 0, tio.c_cc[VMIN] = 1;
  1855. #endif
  1856.     break;
  1857.     case TTY_OUTPUT:
  1858.     tio.c_oflag |= (OPOST|ONLCR);
  1859.         break;
  1860.     case TTY_SAVE:
  1861.         succeed;
  1862.     default:
  1863.     sysError("Unknown PushTty() mode: %d", mode);
  1864.     /*NOTREACHED*/
  1865.   }
  1866.  
  1867. #ifdef HAVE_TCSETATTR
  1868.   if ( tcsetattr(0, TCSANOW, &tio) != 0 )
  1869.   { static int MTOK_warned;            /* MT-OK */
  1870.  
  1871.     if ( !MTOK_warned++ )
  1872.       warning("Failed to set terminal: %s", OsError());
  1873.   }
  1874. #else
  1875. #ifdef TIOCSETAW
  1876.   ioctl(0, TIOCSETAW, &tio);
  1877. #else
  1878.   ioctl(0, TCSETAW, &tio);
  1879.   ioctl(0, TCXONC, (void *)1);
  1880. #endif
  1881. #endif
  1882.  
  1883.   succeed;
  1884. }
  1885.  
  1886.  
  1887. bool
  1888. PopTty(ttybuf *buf)
  1889. { ttymode = buf->mode;
  1890.  
  1891.   if ( GD->cmdline.notty )
  1892.     succeed;
  1893.  
  1894. #ifdef HAVE_TCSETATTR
  1895.   tcsetattr(0, TCSANOW, &buf->tab);
  1896. #else
  1897. #ifdef TIOCSETA
  1898.   ioctl(0, TIOCSETA, &buf->tab);
  1899. #else
  1900.   ioctl(0, TCSETA, &buf->tab);
  1901.   ioctl(0, TCXONC, (void *)1);
  1902. #endif
  1903. #endif
  1904.  
  1905.   succeed;
  1906. }
  1907.  
  1908. #else /* O_HAVE_TERMIO */
  1909.  
  1910. #ifdef HAVE_SGTTYB
  1911.  
  1912. bool
  1913. PushTty(ttybuf *buf, int mode)
  1914. { struct sgttyb tio;
  1915.  
  1916.   buf->mode = ttymode;
  1917.   ttymode = mode;
  1918.  
  1919.   if ( GD->cmdline.notty )
  1920.     succeed;
  1921.  
  1922.   if ( ioctl(0, TIOCGETP, &buf->tab) )  /* save the old one */
  1923.     fail;
  1924.   tio = buf->tab;
  1925.  
  1926.   switch( mode )
  1927.     { case TTY_RAW:
  1928.     tio.sg_flags |= CBREAK;
  1929.     tio.sg_flags &= ~ECHO;
  1930.     break;
  1931.       case TTY_OUTPUT:
  1932.     tio.sg_flags |= (CRMOD);
  1933.     break;
  1934.       case TTY_SAVE:
  1935.     succeed;
  1936.       default:
  1937.     sysError("Unknown PushTty() mode: %d", mode);
  1938.     /*NOTREACHED*/
  1939.       }
  1940.   
  1941.   
  1942.   ioctl(0, TIOCSETP,  &tio);
  1943.   ioctl(0, TIOCSTART, NULL);
  1944.  
  1945.   succeed;
  1946. }
  1947.  
  1948.  
  1949. bool
  1950. PopTty(ttybuf *buf)
  1951. { ttymode = buf->mode;
  1952.  
  1953.   if ( GD->cmdline.notty )
  1954.     succeed;
  1955.  
  1956.   ioctl(0, TIOCSETP,  &buf->tab);
  1957.   ioctl(0, TIOCSTART, NULL);
  1958.  
  1959.   succeed;
  1960. }
  1961.  
  1962. #else /*HAVE_SGTTYB*/
  1963.  
  1964. bool
  1965. PushTty(buf, mode)
  1966. ttybuf *buf;
  1967. int mode;
  1968. { buf->mode = ttymode;
  1969.   ttymode = mode;
  1970.  
  1971.   succeed;
  1972. }
  1973.  
  1974.  
  1975. bool
  1976. PopTty(buf)
  1977. ttybuf *buf;
  1978. { ttymode = buf->mode;
  1979.   if ( ttymode != TTY_RAW )
  1980.     GD->os.prompt_next = TRUE;
  1981.  
  1982.   succeed;
  1983. }
  1984.  
  1985. #endif /*HAVE_SGTTYB*/
  1986. #endif /*O_HAVE_TERMIO*/
  1987.  
  1988.  
  1989.         /********************************
  1990.         *      ENVIRONMENT CONTROL      *
  1991.         *********************************/
  1992.  
  1993. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  1994. Simple  library  to  manipulate  the  Unix  environment.   The  modified
  1995. environment  will  be  passed  to  child  processes  and the can also be
  1996. requested via getenv/2 from Prolog.  Functions
  1997.  
  1998.     char *Setenv(name, value)
  1999.          char *name, *value;
  2000.     
  2001.     Set the Unix environment variable with name `name'.   If  it  exists
  2002.     its  value  is  changed, otherwise a new entry in the environment is
  2003.     created.  The return value is a pointer to the old value, or NULL if
  2004.     the variable is new.
  2005.  
  2006.     char *Unsetenv(name)
  2007.          char *name;
  2008.  
  2009.     Delete a variable from the environment.  Return  value  is  the  old
  2010.     value, or NULL if the variable did not exist.
  2011. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  2012.  
  2013. #ifndef __WIN32__
  2014. char *
  2015. getenv3(const char *name, char *buf, int len)
  2016. { char *s = getenv(name);
  2017.  
  2018.   if ( s && strlen(s) < len )
  2019.   { strcpy(buf, s);
  2020.  
  2021.     return buf;
  2022.   }
  2023.  
  2024.   return NULL;
  2025. }
  2026.  
  2027. int
  2028. getenvl(const char *name)
  2029. { char *s;
  2030.  
  2031.   if ( (s = getenv(name)) )
  2032.     return strlen(s);
  2033.  
  2034.   return -1;
  2035. }
  2036. #endif
  2037.  
  2038. #if HAVE_PUTENV
  2039.  
  2040. int
  2041. Setenv(char *name, char *value)
  2042. { char *buf = alloca(strlen(name) + strlen(value) + 2);
  2043.  
  2044.   if ( buf )
  2045.   { Ssprintf(buf, "%s=%s", name, value);
  2046.  
  2047.     if ( putenv(store_string(buf)) < 0 )
  2048.       return PL_error("setenv", 2, NULL, ERR_NOMEM);
  2049.   } else
  2050.     return PL_error("setenv", 2, NULL, ERR_NOMEM);
  2051.  
  2052.   succeed;
  2053. }
  2054.  
  2055. int
  2056. Unsetenv(char *name)
  2057. { return Setenv(name, "");
  2058. }
  2059.  
  2060. static void
  2061. initEnviron()
  2062. {
  2063. }
  2064.  
  2065. #else /*HAVE_PUTENV*/
  2066.  
  2067. #ifdef tos
  2068. char **environ;
  2069. #else
  2070. extern char **environ;        /* Unix predefined environment */
  2071. #endif
  2072.  
  2073. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  2074. Grow the environment array by one and return the (possibly  moved)  base
  2075. pointer to the new environment.
  2076. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  2077.  
  2078. forwards char    **growEnviron(char**, int);
  2079. forwards char    *matchName(char *, char *);
  2080. forwards void    setEntry(char **, char *, char *);
  2081.  
  2082. static char **
  2083. growEnviron(char **e, int amount)
  2084. { static int filled;
  2085.   static int size = -1;
  2086.  
  2087.   if ( amount == 0 )            /* reset after a dump */
  2088.   { size = -1;
  2089.     return e;
  2090.   }
  2091.  
  2092.   if ( size < 0 )
  2093.   { register char **env, **e1, **e2;
  2094.  
  2095.     for(e1=e, filled=0; *e1; e1++, filled++)
  2096.       ;
  2097.     size = ROUND(filled+10+amount, 32);
  2098.     env = (char **)malloc(size * sizeof(char *));
  2099.     for ( e1=e, e2=env; *e1; *e2++ = *e1++ )
  2100.       ;
  2101.     *e2 = (char *) NULL;
  2102.     filled += amount;
  2103.  
  2104.     return env;
  2105.   }
  2106.  
  2107.   filled += amount;
  2108.   if ( filled + 1 > size )
  2109.   { register char **env, **e1, **e2;
  2110.   
  2111.     size += 32;
  2112.     env = (char **)realloc(e, size * sizeof(char *));
  2113.     for ( e1=e, e2=env; *e1; *e2++ = *e1++ )
  2114.       ;
  2115.     *e2 = (char *) NULL;
  2116.     
  2117.     return env;
  2118.   }
  2119.  
  2120.   return e;
  2121. }
  2122.  
  2123.  
  2124. static void
  2125. initEnviron(void)
  2126. { growEnviron(environ, 0);
  2127. }
  2128.  
  2129.  
  2130. static char *
  2131. matchName(register char *e, register char *name)
  2132. { while( *name && *e == *name )
  2133.     e++, name++;
  2134.  
  2135.   if ( (*e == '=' || *e == EOS) && *name == EOS )
  2136.     return (*e == '=' ? e+1 : e);
  2137.  
  2138.   return (char *) NULL;
  2139. }
  2140.  
  2141.  
  2142. static void
  2143. setEntry(char **e, char *name, char *value)
  2144. { int l = (int)strlen(name);
  2145.  
  2146.   *e = (char *) malloc(l + strlen(value) + 2);
  2147.   strcpy(*e, name);
  2148.   e[0][l++] = '=';
  2149.   strcpy(&e[0][l], value);
  2150. }
  2151.  
  2152.   
  2153. char *
  2154. Setenv(char *name, char *value)
  2155. { char **e;
  2156.   char *v;
  2157.   int n;
  2158.  
  2159.   for(n=0, e=environ; *e; e++, n++)
  2160.   { if ( (v=matchName(*e, name)) != NULL )
  2161.     { if ( !streq(v, value) )
  2162.         setEntry(e, name, value);
  2163.       return v;
  2164.     }
  2165.   }
  2166.   environ = growEnviron(environ, 1);
  2167.   setEntry(&environ[n], name, value);
  2168.   environ[n+1] = (char *) NULL;
  2169.  
  2170.   return (char *) NULL;
  2171. }
  2172.  
  2173.  
  2174. char *
  2175. Unsetenv(char *name)
  2176. { char **e;
  2177.   char *v;
  2178.   int n;
  2179.  
  2180.   for(n=0, e=environ; *e; e++, n++)
  2181.   { if ( (v=matchName(*e, name)) != NULL )
  2182.     { environ = growEnviron(environ, -1);
  2183.       e = &environ[n];
  2184.       do
  2185.       { e[0] = e[1];
  2186.         e++;
  2187.       } while(*e);
  2188.  
  2189.       return v;
  2190.     }
  2191.   }
  2192.  
  2193.   return (char *) NULL;
  2194. }
  2195.  
  2196. #endif /*HAVE_PUTENV*/
  2197.  
  2198.         /********************************
  2199.         *       SYSTEM PROCESSES        *
  2200.         *********************************/
  2201.  
  2202. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  2203.     int System(command)
  2204.     char *command;
  2205.  
  2206.     Invoke a command on the operating system.  The return value  is  the
  2207.     exit  status  of  the  command.   Return  value  0 implies succesful
  2208.     completion. If you are not running Unix your C-library might provide
  2209.     an alternative.
  2210. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  2211.  
  2212. #ifdef unix
  2213. #define SPECIFIC_SYSTEM 1
  2214. #if defined(HAVE_SYS_RESOURCE_H)
  2215. #include <sys/resource.h>
  2216. #endif
  2217. #if defined(HAVE_SYS_WAIT_H) || defined(UNION_WAIT)
  2218. #include <sys/wait.h>
  2219. #endif
  2220.  
  2221. #ifdef UNION_WAIT
  2222.  
  2223. #define wait_t union wait
  2224.  
  2225. #ifndef WEXITSTATUS
  2226. #define WEXITSTATUS(s) ((s).w_status)
  2227. #endif
  2228. #ifndef WTERMSIG
  2229. #define WTERMSIG(s) ((s).w_status)
  2230. #endif
  2231.  
  2232. #else /*UNION_WAIT*/
  2233.  
  2234. #define wait_t int
  2235.  
  2236. #ifndef WEXITSTATUS
  2237. # define WEXITSTATUS(stat_val) ((unsigned)(stat_val) >> 8)
  2238. #endif
  2239. #ifndef WIFEXITED
  2240. # define WIFEXITED(stat_val) (((stat_val) & 255) == 0)
  2241. #endif
  2242.  
  2243. #endif /*UNION_WAIT*/
  2244.  
  2245. int
  2246. System(char *cmd)
  2247. { int pid;
  2248.   char *shell = "/bin/sh";
  2249.   int rval;
  2250.   void (*old_int)();
  2251.   void (*old_stop)();
  2252.  
  2253.   Setenv("PROLOGCHILD", "yes");
  2254.  
  2255.   if ( (pid = vfork()) == -1 )
  2256.   { return PL_error("shell", 2, OsError(), ERR_SYSCALL, ATOM_fork);
  2257.   } else if ( pid == 0 )        /* The child */
  2258.   { int i;
  2259.     int fdmax = getdtablesize();
  2260.  
  2261.     for(i = 3; i < fdmax; i++)
  2262.       close(i);
  2263.     stopItimer();
  2264.  
  2265.     execl(shell, BaseName(shell), "-c", cmd, (char *)0);
  2266.     fatalError("Failed to execute %s: %s", shell, OsError());
  2267.     fail;
  2268.     /*NOTREACHED*/
  2269.   } else
  2270.   { wait_t status;            /* the parent */
  2271.     int n;
  2272.  
  2273.     old_int  = signal(SIGINT,  SIG_IGN);
  2274. #ifdef SIGTSTP
  2275.     old_stop = signal(SIGTSTP, SIG_DFL);
  2276. #endif /* SIGTSTP */
  2277.  
  2278.     while((n = Wait(&status)) != -1 && n != pid);
  2279.     if (n == -1)
  2280.     { term_t tmp = PL_new_term_ref();
  2281.       
  2282.       PL_put_atom_chars(tmp, cmd);
  2283.       PL_error("shell", 2, NULL, ERR_SHELL_FAILED, tmp);
  2284.  
  2285.       rval = 1;
  2286.     } else if (WIFEXITED(status))
  2287.     { rval = WEXITSTATUS(status);
  2288. #ifdef WIFSIGNALED
  2289.     } else if (WIFSIGNALED(status))
  2290.     { term_t tmp = PL_new_term_ref();
  2291.       int sig = WTERMSIG(status);
  2292.       
  2293.       PL_put_atom_chars(tmp, cmd);
  2294.       PL_error("shell", 2, NULL, ERR_SHELL_SIGNALLED, tmp, sig);
  2295.       rval = 1;
  2296. #endif
  2297.     } else
  2298.     { rval = 1;                /* make gcc happy */
  2299.       fatalError("Unknown return code from wait(3)");
  2300.       /*NOTREACHED*/
  2301.     }
  2302.   }
  2303.  
  2304.   signal(SIGINT,  old_int);        /* restore signal handlers */
  2305. #ifdef SIGTSTP
  2306.   signal(SIGTSTP, old_stop);
  2307. #endif /* SIGTSTP */
  2308.  
  2309.   return rval;
  2310. }
  2311. #endif /* unix */
  2312.  
  2313. #ifdef tos
  2314. #define SPECIFIC_SYSTEM 1
  2315. #include <aes.h>
  2316.  
  2317. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  2318. The routine system_via_shell() has been written by Tom Demeijer.  Thanks!
  2319. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  2320.  
  2321. #define _SHELL_P ((long *)0x4f6L)
  2322. #define SHELL_OK (do_sys != 0)
  2323.  
  2324. int cdecl (*do_sys)(const char *cmd); /* Parameter on stack ! */
  2325.  
  2326. static int
  2327. system_via_shell(const char *cmd)
  2328. { long oldssp;
  2329.  
  2330.   oldssp = Super((void *)0L);
  2331.   do_sys = (void (*))*_SHELL_P;
  2332.   Super((void *)oldssp);
  2333.  
  2334.   if(cmd==NULL && SHELL_OK)
  2335.     return 0;
  2336.  
  2337.   if (SHELL_OK)
  2338.     return do_sys(cmd);
  2339.  
  2340.   return -1;
  2341. }
  2342.  
  2343. int
  2344. System(command)
  2345. char *command;
  2346. { char     tmp[MANIPULATION];
  2347.   char       path[MAXPATHLEN];
  2348.   char       *cmd_path;
  2349.   COMMAND  commandline;
  2350.   char       *s, *q;
  2351.   int       status, l;
  2352.   char       *cmd = command;
  2353.  
  2354.   if ( (status = system_via_shell(command)) != -1 )
  2355.   { Sprintf("\033e");        /* get cursor back */
  2356.  
  2357.     return status;
  2358.   }
  2359.  
  2360.     /* get the name of the executable and store in path */
  2361.   for(s=path; *cmd != EOS && !isBlank(*cmd); *s++ = *cmd++)
  2362.     ;
  2363.   *s = EOS;
  2364.   if ( !(cmd_path = Which(path, tmp)) )
  2365.   { warning("%s: command not found", path);
  2366.     return 1;
  2367.   }
  2368.  
  2369.     /* copy the command in commandline */
  2370.   while( isBlank(*cmd) )
  2371.     cmd++;
  2372.  
  2373.   for(l = 0, s = cmd, q = commandline.command_tail; *s && l <= 126; s++ )
  2374.   { if ( *s != '\'' )
  2375.     { *q++ = (*s == '/' ? '\\' : *s);
  2376.       l++;
  2377.     }
  2378.   }
  2379.   commandline.length = l;
  2380.   *q = EOS;
  2381.   
  2382.     /* execute the command */
  2383.   if ( (status = (int) Pexec(0, OsPath(cmd_path), &commandline, NULL)) < 0 )
  2384.   { warning("Failed to execute %s: %s", command, OsError());
  2385.     return 1;
  2386.   }
  2387.  
  2388.     /* clean up after a graphics application */
  2389.   if ( strpostfix(cmd_path, ".prg") || strpostfix(cmd_path, ".tos") )
  2390.   { graf_mouse(M_OFF, NULL);        /* get rid of the mouse */
  2391.     Sprintf("\033e\033E");        /* clear screen and get cursor */
  2392.   }  
  2393.  
  2394.   return status;
  2395. }
  2396. #endif
  2397.  
  2398. #ifdef HAVE_WINEXEC            /* Windows 3.1 */
  2399. #define SPECIFIC_SYSTEM 1
  2400.  
  2401. int
  2402. System(char *command)
  2403. { char *msg;
  2404.   int rval = WinExec(command, SW_SHOWNORMAL);
  2405.  
  2406.   if ( rval < 32 )
  2407.   { switch( rval )
  2408.     { case 0:    msg = "Not enough memory"; break;
  2409.       case 2:    msg = "File not found"; break;
  2410.       case 3:    msg = "No path"; break;
  2411.       case 5:    msg = "Unknown error"; break;
  2412.       case 6:    msg = "Lib requires separate data segment"; break;
  2413.       case 8:    msg = "Not enough memory"; break;
  2414.       case 10:    msg = "Incompatible Windows version"; break;
  2415.       case 11:    msg = "Bad executable file"; break;
  2416.       case 12:    msg = "Incompatible operating system"; break;
  2417.       case 13:    msg = "MS-DOS 4.0 executable"; break;
  2418.       case 14:    msg = "Unknown executable file type"; break;
  2419.       case 15:    msg = "Real-mode application"; break;
  2420.       case 16:    msg = "Cannot start multiple copies"; break;
  2421.       case 19:    msg = "Executable is compressed"; break;
  2422.       case 20:    msg = "Invalid DLL"; break;
  2423.       case 21:    msg = "Application is 32-bits"; break;
  2424.       default:    msg = "Unknown error";
  2425.     }
  2426.  
  2427.     warning("Could not start %s: error %d (%s)",
  2428.         command, rval, msg);
  2429.     return 1;
  2430.   }
  2431.  
  2432.   return 0;
  2433. }
  2434. #endif
  2435.  
  2436.  
  2437. #ifdef __WIN32__
  2438. #define SPECIFIC_SYSTEM 1
  2439.  
  2440.                     /* definition in pl-nt.c */
  2441. #endif
  2442.  
  2443. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  2444. Nothing special is needed.  Just hope the C-library defines system().
  2445. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  2446.  
  2447. #ifndef SPECIFIC_SYSTEM
  2448.  
  2449. int
  2450. System(command)
  2451. char *command;
  2452. { return system(command);
  2453. }
  2454.  
  2455. #endif
  2456.  
  2457. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  2458.     char *Symbols(char *buf)
  2459.  
  2460.     Return the path name of the executable of SWI-Prolog. Used by the -c
  2461.     compiler to generate the #!<path> header line and by the incremental
  2462.     loader, who gives this path to ld, using ld -A <path>.
  2463. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  2464.  
  2465. #ifndef __WIN32__            /* Win32 version in pl-nt.c */
  2466.  
  2467. char *
  2468. Symbols(char *buffer)
  2469. { char *file;
  2470.   char buf[MAXPATHLEN];
  2471.   char tmp[MAXPATHLEN];
  2472.  
  2473.   PrologPath(GD->cmdline.argv[0], buf);
  2474.   file = Which(buf, tmp);
  2475.  
  2476. #if __unix__                /* argv[0] can be an #! script! */
  2477.   if ( file )
  2478.   { int n, fd;
  2479.     char buf[MAXPATHLEN];
  2480.  
  2481.     if ( (fd = open(file, O_RDONLY)) < 0 )
  2482.     { warning("Cannot open %s: %s", file, OsError());
  2483.       return file;
  2484.     }
  2485.  
  2486.     if ( (n=read(fd, buf, sizeof(buf)-1)) > 0 )
  2487.     { close(fd);
  2488.  
  2489.       buf[n] = EOS;
  2490.       if ( strncmp(buf, "#!", 2) == 0 )
  2491.       { char *s = &buf[2], *q;
  2492.     while(*s && isBlank(*s))
  2493.       s++;
  2494.     for(q=s; *q && !isBlank(*q); q++)
  2495.       ;
  2496.     *q = EOS;
  2497.  
  2498.     strcpy(buffer, s);
  2499.  
  2500.     return buffer;
  2501.       }
  2502.     }
  2503.  
  2504.     close(fd);
  2505.   }
  2506. #endif /*__unix__*/
  2507.  
  2508.   if ( file )
  2509.     strcpy(buffer, file);
  2510.   else
  2511.     strcpy(buffer, buf);
  2512.  
  2513.   return buffer;
  2514. }
  2515. #endif /*__WIN32__*/
  2516.  
  2517.  
  2518. #if unix
  2519. static char *
  2520. okToExec(const char *s)
  2521. { struct stat stbuff;
  2522.  
  2523.   if (statfunc(s, &stbuff) == 0 &&            /* stat it */
  2524.      (stbuff.st_mode & S_IFMT) == S_IFREG &&    /* check for file */
  2525.      access(s, X_OK) == 0)            /* can be executed? */
  2526.     return (char *)s;
  2527.   else
  2528.     return (char *) NULL;
  2529. }
  2530. #define PATHSEP    ':'
  2531. #endif /* unix */
  2532.  
  2533. #ifdef tos
  2534. #define EXEC_EXTENSIONS { ".ttp", ".prg", NULL }
  2535. #define PATHSEP ','
  2536. #endif
  2537.  
  2538. #if defined(OS2) || defined(__DOS__) || defined(__WINDOWS__) || defined(__WIN32__)
  2539. #define EXEC_EXTENSIONS { ".exe", ".com", ".bat", ".cmd", NULL }
  2540. #define PATHSEP ';'
  2541. #endif
  2542.  
  2543. #ifdef EXEC_EXTENSIONS
  2544.  
  2545. static char *
  2546. okToExec(const char *s)
  2547. { static char *extensions[] = EXEC_EXTENSIONS;
  2548.   static char **ext;
  2549.  
  2550.   DEBUG(2, Sdprintf("Checking %s\n", s));
  2551.   for(ext = extensions; *ext; ext++)
  2552.     if ( stripostfix(s, *ext) )
  2553.       return ExistsFile(s) ? (char *)s : (char *) NULL;
  2554.  
  2555.   for(ext = extensions; *ext; ext++)
  2556.   { static char path[MAXPATHLEN];
  2557.  
  2558.     strcpy(path, s);
  2559.     strcat(path, *ext);
  2560.     if ( ExistsFile(path) )
  2561.       return path;
  2562.   }
  2563.  
  2564.   return (char *) NULL;
  2565. }
  2566. #endif /*EXEC_EXTENSIONS*/
  2567.  
  2568. char *
  2569. Which(const char *program, char *fullname)
  2570. { char *path, *dir;
  2571.   char *e;
  2572.  
  2573.   if ( IsAbsolutePath(program) ||
  2574. #if OS2 && EMX
  2575.        isDriveRelativePath(program) ||
  2576. #endif /* OS2 */
  2577.        isRelativePath(program) ||
  2578.        strchr(program, '/') )
  2579.   { if ( (e = okToExec(program)) != NULL )
  2580.     { strcpy(fullname, e);
  2581.       
  2582.       return fullname;
  2583.     }
  2584.  
  2585.     return NULL;
  2586.   }
  2587.  
  2588. #if OS2 && EMX
  2589.   if ((e = okToExec(program)) != NULL)
  2590.   {
  2591.     getcwd(fullname, MAXPATHLEN);
  2592.     strcat(fullname, "/");
  2593.     strcat(fullname, e);
  2594.     return fullname;
  2595.   }
  2596. #endif /* OS2 */
  2597.   if  ((path = getenv("PATH") ) == 0)
  2598.     path = DEFAULT_PATH;
  2599.  
  2600.   while(*path)
  2601.   { if ( *path == PATHSEP )
  2602.     { if ( (e = okToExec(program)) != NULL)
  2603.       { strcpy(fullname, e);
  2604.  
  2605.         return fullname;
  2606.       } else
  2607.         path++;                /* fix by Ron Hess (hess@sco.com) */
  2608.     } else
  2609.     { char tmp[MAXPATHLEN];
  2610.  
  2611.       for(dir = fullname; *path && *path != PATHSEP; *dir++ = *path++)
  2612.     ;
  2613.       if (*path)
  2614.     path++;                /* skip : */
  2615.       if (strlen(fullname) + strlen(program)+2 > MAXPATHLEN)
  2616.         continue;
  2617.       *dir++ = '/';
  2618.       *dir = EOS;
  2619.       strcpy(dir, program);
  2620.       if ( (e = okToExec(OsPath(fullname, tmp))) != NULL )
  2621.     return e;
  2622.     }
  2623.   }
  2624.  
  2625.   return NULL;
  2626. }
  2627.  
  2628.  
  2629. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  2630.     void Pause(time)
  2631.      real time;
  2632.  
  2633.     Suspend execution `time' seconds.   Time  is  given  as  a  floating
  2634.     point,  expressing  the  time  to sleep in seconds.
  2635. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  2636.  
  2637. #ifdef HAVE_SELECT
  2638.  
  2639. void
  2640. Pause(real time)
  2641. { struct timeval timeout;
  2642.  
  2643.   if ( time <= 0.0 )
  2644.     return;
  2645.  
  2646.   if ( time < 60.0 )        /* select() is expensive. Does it make sense */
  2647.   { timeout.tv_sec = (int) time;
  2648.     timeout.tv_usec = (int)(time * 1000000) % 1000000;
  2649.     select(32, NULL, NULL, NULL, &timeout);
  2650.   } else
  2651.     sleep( (int)(time+0.5) );
  2652. }
  2653.  
  2654. #else /*!HAVE_SELECT*/
  2655. #ifdef HAVE_DOSSLEEP
  2656.  
  2657. void                            /* a millisecond granualrity. */
  2658. Pause(time)                     /* the EMX function sleep uses a seconds */
  2659. real time;                      /* granularity only. */
  2660. {                               /* the select() trick does not work at all. */
  2661.   if ( time <= 0.0 )
  2662.     return;
  2663.  
  2664.   DosSleep((ULONG)(time * 1000));
  2665. }
  2666.  
  2667. #else /*HAVE_DOSSLEEP*/
  2668. #ifdef HAVE_SLEEP
  2669.  
  2670. void
  2671. Pause(real t)
  2672. { if ( t <= 0.5 )
  2673.     return;
  2674.  
  2675.   sleep((int)(t + 0.5));
  2676. }
  2677. #else /*HAVE_SLEEP*/
  2678. #ifdef HAVE_DELAY
  2679.  
  2680. void
  2681. Pause(real t)
  2682. { delay((int)(t * 1000));
  2683. }
  2684.  
  2685. #endif /*HAVE_DELAY*/
  2686. #endif /*HAVE_SLEEP*/
  2687. #endif /*HAVE_DOSSLEEP*/
  2688. #endif /*HAVE_SELECT*/
  2689.  
  2690. #if tos
  2691. void
  2692. Pause(t)
  2693. real t;
  2694. { long wait = (long)(t * 200.0);
  2695.   long start_tick = clock();
  2696.   long end_tick = wait + start_tick;
  2697.  
  2698.   while( clock() < end_tick )
  2699.   { if ( kbhit() )
  2700.     { wait_ticks += clock() - start_tick;
  2701.       start_tick = clock();
  2702.       TtyAddChar(getch());
  2703.     }
  2704.   }
  2705.  
  2706.   wait_ticks += end_tick - start_tick;
  2707. }
  2708. #endif
  2709.